home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / SRC / TOOLBOX / GETOBJEC.MOD < prev    next >
Encoding:
Modula Implementation  |  1993-03-12  |  9.3 KB  |  380 lines
  1. IMPLEMENTATION MODULE GetObject;
  2.  
  3. (*
  4. Manipulating AES Object Structure.
  5.  
  6. UK __DATE__ __TIME__
  7. *)
  8.  
  9. (*IMP_SWITCHES*)
  10.  
  11. FROM RcMgr  IMPORT GRect,GPnt;
  12. FROM PORTAB IMPORT ANYPOINTER,SIGNEDWORD,UNSIGNEDWORD,ANYWORD;
  13. CAST_IMPORT
  14.  
  15. IMPORT AES;
  16.  
  17. PROCEDURE Next(Tree : AES.TreePtr;
  18.                Index: AES.ObjectIndex): AES.ObjectPtr;
  19. BEGIN
  20. #if not UNIX
  21. #if long
  22.   RETURN CAST(AES.ObjectPtr,LONG(Tree^[Index].ObNext));
  23. #else
  24.   RETURN Tree^[Index].ObNext;
  25. #endif
  26. #else
  27.  
  28. #endif
  29. END Next;
  30.  
  31. PROCEDURE Head(Tree : AES.TreePtr;
  32.                Index: AES.ObjectIndex): AES.ObjectPtr;
  33. BEGIN
  34. #if not UNIX
  35. #if long
  36.   RETURN CAST(AES.ObjectPtr,LONG(Tree^[Index].ObHead));
  37. #else
  38.   RETURN Tree^[Index].ObHead;
  39. #endif
  40. #else
  41.  
  42. #endif
  43. END Head;
  44.  
  45. PROCEDURE Tail(Tree : AES.TreePtr;
  46.                Index: AES.ObjectIndex): AES.ObjectPtr;
  47. BEGIN
  48. #if not UNIX
  49. #if long
  50.   RETURN CAST(AES.ObjectPtr,LONG(Tree^[Index].ObTail));
  51. #else
  52.   RETURN Tree^[Index].ObTail;
  53. #endif
  54. #else
  55.  
  56. #endif
  57. END Tail;
  58.  
  59. PROCEDURE Extnd(Tree : AES.TreePtr;
  60.                 Index: AES.ObjectIndex): UNSIGNEDWORD;
  61. BEGIN
  62. #if not UNIX
  63. #if packing
  64.   RETURN ORD(CAST(CHAR,Tree^[Index].ObExtnd));
  65. #else
  66.   RETURN Tree^[Index].ObType DIV 256;
  67. #endif
  68. #else
  69.  
  70. #endif
  71. END Extnd;
  72.  
  73. PROCEDURE Type(Tree : AES.TreePtr;
  74.                Index: AES.ObjectIndex): AES.ObjectTypes;
  75. BEGIN
  76. #if not UNIX
  77. #if (defined MM2)
  78.   RETURN VAL(AES.ObjectTypes,ORD(Tree^[Index].ObType));
  79. #else
  80. #if packing
  81.   RETURN Tree^[Index].ObType;
  82. #else
  83.   RETURN VAL(AES.ObjectTypes,Tree^[Index].ObType MOD 256);
  84. #endif
  85. #endif
  86. #else
  87.  
  88. #endif
  89. END Type;
  90. #if no_set_return
  91. PROCEDURE Flags(Tree : AES.TreePtr;
  92.                 Index: AES.ObjectIndex): ANYWORD;
  93. #else
  94. PROCEDURE Flags(Tree : AES.TreePtr;
  95.                 Index: AES.ObjectIndex): AES.ObjectFlag;
  96. #endif
  97. BEGIN
  98. #if not UNIX
  99. #if no_set_return
  100.   RETURN CAST(ANYWORD,Tree^[Index].ObFlags);
  101. #else
  102.   RETURN Tree^[Index].ObFlags;
  103. #endif
  104. #else
  105.  
  106. #endif
  107. END Flags;
  108. #if no_set_return
  109. PROCEDURE State(Tree : AES.TreePtr;
  110.                 Index: AES.ObjectIndex): ANYWORD;
  111. #else
  112. PROCEDURE State(Tree : AES.TreePtr;
  113.                 Index: AES.ObjectIndex): AES.ObjectState;
  114. #endif
  115. BEGIN
  116. #if not UNIX
  117. #if no_set_return
  118.   RETURN CAST(ANYWORD,Tree^[Index].ObState);
  119. #else
  120.   RETURN Tree^[Index].ObState;
  121. #endif
  122. #else
  123.  
  124. #endif
  125. END State;
  126.  
  127. PROCEDURE Spec(Tree : AES.TreePtr;
  128.                Index: AES.ObjectIndex): ANYPOINTER;
  129.  
  130. BEGIN
  131.   (* do NOT handle GUserDef here *)
  132. #if not UNIX
  133.   IF NOT(AES.Indirect IN Tree^[Index].ObFlags) THEN
  134.     RETURN Tree^[Index].ObSpec.Address;
  135.   ELSE
  136.     RETURN Tree^[Index].ObSpec.Extension^.Spec.Address;
  137.   END;
  138. #else
  139.  
  140. #endif
  141. END Spec;
  142.  
  143. PROCEDURE X(Tree : AES.TreePtr;
  144.             Index: AES.ObjectIndex): SIGNEDWORD;
  145. BEGIN
  146. #if not UNIX
  147.   RETURN Tree^[Index].ObX;
  148. #else
  149.  
  150. #endif
  151. END X;
  152.  
  153. PROCEDURE Y(Tree : AES.TreePtr;
  154.             Index: AES.ObjectIndex): SIGNEDWORD;
  155. BEGIN
  156. #if not UNIX
  157.   RETURN Tree^[Index].ObY;
  158. #else
  159.  
  160. #endif
  161. END Y;
  162.  
  163. PROCEDURE Width(Tree : AES.TreePtr;
  164.                 Index: AES.ObjectIndex): UNSIGNEDWORD;
  165. BEGIN
  166. #if not UNIX
  167.   RETURN Tree^[Index].ObWidth;
  168. #else
  169.  
  170. #endif
  171. END Width;
  172.  
  173. PROCEDURE Height(Tree : AES.TreePtr;
  174.                  Index: AES.ObjectIndex): UNSIGNEDWORD;
  175. BEGIN
  176. #if not UNIX
  177.   IF Type(Tree,Index) = AES.GIcon THEN
  178.     WITH Tree^[Index].ObSpec.IconBlock^ DO
  179.       RETURN IBHIcon + IBHText;
  180.     END;
  181.   ELSIF Type(Tree,Index) = AES.GImage THEN
  182.     WITH Tree^[Index].ObSpec.BitBlock^ DO
  183.       RETURN BIHL;
  184.     END;
  185.   ELSE
  186.     RETURN Tree^[Index].ObHeight;
  187.   END;
  188. #else
  189.  
  190. #endif
  191. END Height;
  192.  
  193. PROCEDURE Pnt(    Tree : AES.TreePtr;
  194.                   Index: AES.ObjectIndex;
  195.               VAR Pnt  : GPnt);
  196. BEGIN
  197. #if not UNIX
  198.   WITH Tree^[Index] DO
  199.     WITH Pnt DO
  200.       GX:= ObX;
  201.       GY:= ObY;
  202.     END;
  203.   END;
  204. #else
  205.  
  206. #endif
  207. END Pnt;
  208.  
  209. PROCEDURE Rect(    Tree : AES.TreePtr;
  210.                    Index: AES.ObjectIndex;
  211.                VAR Rect : GRect);
  212. BEGIN
  213.   WITH Rect DO
  214. #if not UNIX
  215.     WITH Tree^[Index] DO
  216.       GX:= ObX;
  217.       GY:= ObY;
  218.       GW:= ObWidth;
  219.       GH:= ObHeight;
  220.     END;
  221. #else
  222.  
  223. #endif
  224.   END;
  225. END Rect;
  226.  
  227. PROCEDURE Color(    Tree : AES.TreePtr;
  228.                     Index: AES.ObjectIndex;
  229.                 VAR Inf  : ColorInfo);
  230.  
  231. VAR SpecInfo    : AES.ObjectSpec;
  232.     ComplexColor: AES.ObjectField;
  233.  
  234. BEGIN
  235.   SpecInfo.Address:= Spec(Tree,Index);
  236.   CASE Type(Tree,Index) OF
  237.     AES.GBox,AES.GIBox,AES.GBoxChar:
  238. #if packing
  239.       ComplexColor:= SpecInfo.Color;
  240. #else
  241.       ComplexColor:= CAST(AES.ObjectField,SHORT(SpecInfo.Color DIV 65536));
  242. #endif
  243.   | AES.GText,AES.GBoxText,AES.GFText,AES.GFBoxText:
  244.       ComplexColor:= SpecInfo.TextInfo^.TEColor;
  245.   ELSE
  246.     RETURN;
  247.   END;
  248.  
  249. #undef CAST
  250.  
  251. #if (defined LPRM2) || (defined SPCM2)
  252.   WITH Inf DO
  253.     FrameColor:= VAL(AES.ObjectColors,
  254.                      VAL(UNSIGNEDWORD,
  255.                          ComplexColor - AES.ObjectField{0..(AES.FrameShift - 1)})
  256.                          DIV AES.FrameOffset);
  257.     TextColor:= VAL(AES.ObjectColors,
  258.                     VAL(UNSIGNEDWORD,ComplexColor - AES.ObjectField{0..(AES.TextShift - 1),AES.FrameShift..15})
  259.                         DIV AES.TextOffset);
  260.     Mode:= VAL(AES.InsideModes,
  261.                VAL(UNSIGNEDWORD,ComplexColor - AES.ObjectField{0..(AES.ModeShift - 1),AES.TextShift..15})
  262.                    DIV AES.ModeOffset);
  263.     Pattern:= VAL(AES.InsidePatterns,
  264.               VAL(UNSIGNEDWORD,ComplexColor - AES.ObjectField{0..(AES.PatternShift - 1),AES.ModeShift..15})
  265.                   DIV AES.PatternOffset);
  266.     InsideColor:= VAL(AES.ObjectColors,
  267.                   VAL(UNSIGNEDWORD,ComplexColor - AES.ObjectField{AES.PatternShift..15})
  268.                      );
  269.   END;
  270. #elif (defined MM2) || (defined HM2) || (defined ISOM2)
  271.   WITH Inf DO
  272.     FrameColor:= VAL(AES.ObjectColors,
  273.                      CAST(UNSIGNEDWORD,
  274.                           ComplexColor - AES.ObjectField{0..(AES.FrameShift - 1)})
  275.                           DIV AES.FrameOffset);
  276.     TextColor:= VAL(AES.ObjectColors,
  277.                     CAST(UNSIGNEDWORD,ComplexColor - AES.ObjectField{0..(AES.TextShift - 1),AES.FrameShift..15})
  278.                          DIV AES.TextOffset);
  279.     Mode:= VAL(AES.InsideModes,
  280.                CAST(UNSIGNEDWORD,ComplexColor - AES.ObjectField{0..(AES.ModeShift - 1),AES.TextShift..15})
  281.                     DIV AES.ModeOffset);
  282.     Pattern:= VAL(AES.InsidePatterns,
  283.               CAST(UNSIGNEDWORD,ComplexColor - AES.ObjectField{0..(AES.PatternShift - 1),AES.ModeShift..15})
  284.                    DIV AES.PatternOffset);
  285.     InsideColor:= VAL(AES.ObjectColors,
  286.                   CAST(UNSIGNEDWORD,ComplexColor - AES.ObjectField{AES.PatternShift..15})
  287.                       );
  288.   END;
  289. #else
  290.   WITH Inf DO
  291.     FrameColor:= VAL(AES.ObjectColors,
  292.                      UNSIGNEDWORD(ComplexColor - AES.ObjectField{0..(AES.FrameShift - 1)})
  293.                      DIV AES.FrameOffset);
  294.     TextColor:= VAL(AES.ObjectColors,
  295.                     UNSIGNEDWORD(ComplexColor - AES.ObjectField{0..(AES.TextShift - 1),AES.FrameShift..15})
  296.                     DIV AES.TextOffset);
  297.     Mode:= VAL(AES.InsideModes,
  298.                UNSIGNEDWORD(ComplexColor - AES.ObjectField{0..(AES.ModeShift - 1),AES.TextShift..15})
  299.                DIV AES.ModeOffset);
  300.     Pattern:= VAL(AES.InsidePatterns,
  301.                   UNSIGNEDWORD(ComplexColor - AES.ObjectField{0..(AES.PatternShift - 1),AES.ModeShift..15})
  302.                   DIV AES.PatternOffset);
  303.     InsideColor:= VAL(AES.ObjectColors,
  304.                       UNSIGNEDWORD(ComplexColor - AES.ObjectField{AES.PatternShift..15})
  305.                       );
  306.   END;
  307. #endif
  308. END Color;
  309.  
  310. PROCEDURE StringPtr(Tree : AES.TreePtr;
  311.                     Index: AES.ObjectIndex): AES.StringPtr;
  312. BEGIN
  313. #if not UNIX
  314.   CASE Type(Tree,Index) OF
  315.     AES.GButton,AES.GString,AES.GTitle:
  316. #if no_set_return
  317.       IF AES.Indirect IN CAST(AES.ObjectFlag,Flags(Tree,Index)) THEN
  318. #else
  319.       IF AES.Indirect IN Flags(Tree,Index) THEN
  320. #endif
  321.         RETURN Tree^[Index].ObSpec.Extension^.Spec.String;
  322.       ELSE
  323.         RETURN Tree^[Index].ObSpec.String;
  324.       END;
  325.   | AES.GText,AES.GFText,AES.GBoxText,AES.GFBoxText:
  326. #if no_set_return
  327.       IF AES.Indirect IN CAST(AES.ObjectFlag,Flags(Tree,Index)) THEN
  328. #else
  329.       IF AES.Indirect IN Flags(Tree,Index) THEN
  330. #endif
  331.         RETURN Tree^[Index].ObSpec.Extension^.Spec.TextInfo^.TEPText;
  332.       ELSE
  333.         RETURN Tree^[Index].ObSpec.TextInfo^.TEPText;
  334.       END;
  335.   ELSE
  336.     RETURN NIL;
  337.   END;
  338. #else
  339.  
  340. #endif
  341. END StringPtr;
  342.  
  343. PROCEDURE String(    Tree : AES.TreePtr;
  344.                      Index: AES.ObjectIndex;
  345.                  VAR Str  : AES.String);
  346.  
  347. VAR i: AES.StringRange;
  348.  
  349. BEGIN
  350. #if not UNIX
  351.   CASE Type(Tree,Index) OF
  352.     AES.GButton,AES.GString,AES.GTitle:
  353.       WITH Tree^[Index].ObSpec DO
  354.         i:= 0;
  355.         REPEAT
  356.           Str[i]:= String^[i];
  357.           INC(i)
  358.         UNTIL String^[i] = 0C;
  359.         Str[i]:= 0C;
  360.       END;
  361.   | AES.GText,AES.GFText,AES.GBoxText,AES.GFBoxText:
  362.       WITH Tree^[Index].ObSpec.TextInfo^ DO
  363.         i:= 0;
  364.         REPEAT
  365.           Str[i]:= TEPText^[i];
  366.           INC(i)
  367.         UNTIL TEPText^[i] = 0C;
  368.         Str[i]:= 0C;
  369.      END;
  370.   ELSE
  371.     Str:= "";
  372.   END;
  373. #else
  374.  
  375. #endif
  376. END String;
  377.  
  378. END GetObject.
  379.  
  380.